home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / CHECKMD.M < prev    next >
Encoding:
Text File  |  1989-07-28  |  6.1 KB  |  221 lines
  1. MODULE CheckMD; (*$ E MOS *)
  2.  
  3. FROM Terminal IMPORT Read, WriteString, WriteLn;
  4.  
  5. FROM StrConv IMPORT LHexToStr;
  6.  
  7. FROM MOSCtrl IMPORT ProcessID;
  8.  
  9. FROM SYSTEM IMPORT ADDRESS, LONGWORD;
  10.  
  11.  
  12. TYPE P_MD = POINTER TO MD;
  13.      
  14.      MD = RECORD
  15.             next: P_MD;
  16.             start: ADDRESS;
  17.             length: LONGCARD;
  18.             owner: LONGWORD    (* Bit 31: length ungerade, Rest des  *)
  19.                                (* 1. Byte: ModLevel, Rest: Prozeß-ID *)
  20.           END;
  21.  
  22. TYPE P_MPB = POINTER TO MPB;
  23.  
  24.      MPB = RECORD
  25.              free: P_MD;
  26.              used: P_MD;
  27.              boomer: P_MD
  28.            END;
  29.  
  30. VAR MPBPtr: P_MPB;
  31.  
  32. PROCEDURE GetMPBPtr;
  33.   (*$L-*)
  34.   BEGIN
  35.     ASSEMBLER
  36.         ; MPB-Root suchen
  37.         CLR.L   MPBPtr
  38.  
  39.         PEA     set_trc(PC)
  40.         MOVE    #4,-(A7)
  41.         MOVE    #5,-(A7)
  42.         TRAP    #13             ; setexec (4, set_trc)
  43.         ADDQ.L  #8,A7
  44.         ILLEGAL
  45.  
  46.         MOVE.L  #-1,-(A7)
  47.         MOVE.W  #$48,-(A7)
  48.         TRAP    #1              ; malloc (-1L)
  49.         ADDQ.L  #6,A7
  50.  
  51.         PEA     rst_trc(PC)
  52.         MOVE    #4,-(A7)
  53.         MOVE    #5,-(A7)
  54.         TRAP    #13             ; setexec (4, rst_trc)
  55.         ADDQ.L  #8,A7
  56.         ILLEGAL
  57.  
  58.         RTS
  59.  
  60.       set_trc:
  61.         MOVE.L  D0,$10          ; vektor #4 wiederherstellen
  62.         LEA     sv_trc(PC),A0
  63.         MOVE.L  $24,(A0)        ; vektor #9 (trace) retten
  64.         LEA     trace(PC),A0
  65.         MOVE.L  A0,$24          ; vektor #9 (trace) setzen
  66.         ORI.W   #$8000,(A7)     ; Trace-Bit setzen
  67.         ADDQ.L  #2,2(A7)        ; PC hinter ILLEGAL-Instr
  68.         RTE
  69.  
  70.       rst_trc:
  71.         MOVE.L  D0,$10          ; vektor #4 wiederherstellen
  72.         MOVE.L  sv_trc(PC),$24  ; vektor #9 (trace) rücksetzen
  73.         ANDI.W  #$3FFF,(A7)     ; Trace-Bit(s) löschen
  74.         ADDQ.L  #2,2(A7)        ; PC hinter ILLEGAL-Instr
  75.         RTE
  76.  
  77.       sv_trc:
  78.         DC.L    0
  79.  
  80.       trace:
  81.         MOVE.L  A0,-(A7)
  82.         MOVE.L  4+2(A7),A0
  83.         CMPI.W  #$4E90,(A0)     ; JMP (A0) - Instr ?
  84.         BEQ     trc2
  85.       trc3
  86.         MOVE.L  (A7)+,A0
  87.         ORI.W   #$8000,(A7)     ; Trace-Bit erneut setzen
  88.         RTE
  89.       trc2:
  90.         LEA     trace2(PC),A0
  91.         MOVE.L  A0,$24          ; setexec (9, trace2)
  92.         BRA     trc3
  93.  
  94.       trace2:
  95.         MOVE.L  A0,-(A7)
  96.         MOVE.L  4+2(A7),A0
  97.         CMPI.W  #$6100,(A0)     ; JSR x.L - Instr ?
  98.         BEQ     trc4
  99.         MOVE.L  (A7)+,A0
  100.         RTE
  101.       trc4:
  102.         CMPI.L  #-1,4+6(A7)     ; steht -1 (malloc-param) auf Stack ?
  103.         BNE     trc_err         ; nicht gefunden
  104.         TST.B   4+6+4(A7)       ; ist Adr. v. MPB < $1000000 ?
  105.         BNE     trc_err         ; nicht gefunden
  106.         MOVE.L  4+6+4(A7),MPBPtr ; auf Supervisor-Stack steht MPB-Pointer
  107.       trc_err
  108.         MOVE.L  (A7)+,A0
  109.         ANDI.W  #$7FFF,(A7)     ; Trace-Bit löschen
  110.         RTE
  111.     END
  112.   END GetMPBPtr;
  113.   (*$L=*)
  114.  
  115.  
  116. PROCEDURE GetMPB (VAR mpb: MPB);
  117.   (*$L-*)
  118.   BEGIN
  119.     ASSEMBLER
  120.         MOVE.L  -(A3),A2
  121.         PEA     l(PC)
  122.         MOVE    #38,-(A7)
  123.         TRAP    #14             ; Supexec ()
  124.         ADDQ.L  #6,A7
  125.         RTS
  126.         
  127.       l MOVE.L  MPBPtr,A0
  128.         MOVE.L  MPB.free(A0),MPB.free(A2)
  129.         MOVE.L  MPB.used(A0),MPB.used(A2)
  130.         MOVE.L  MPB.boomer(A0),MPB.boomer(A2)
  131.     END
  132.   END GetMPB;
  133.   (*$L=*)
  134.  
  135. PROCEDURE WriteLHex (l:LONGWORD);
  136.   BEGIN
  137.     WriteString (LHexToStr(l,9))
  138.   END WriteLHex;
  139.  
  140. VAR mpb : MPB;
  141.     used: P_MD;
  142.     free: P_MD;
  143.     ch  : CHAR;
  144.  
  145. PROCEDURE prt (used: P_MD);
  146.   BEGIN
  147.     WriteString (' start: '); WriteLHex (used^.start);
  148.     WriteString (' length: '); WriteLHex (used^.length);
  149.     WriteString (' end: '); WriteLHex (LONGCARD(used^.start)+used^.length);
  150.     WriteString (' owner: '); WriteLHex (used^.owner);
  151.     WriteLn;
  152.     Read (ch);
  153.   END prt;
  154.  
  155. BEGIN
  156.   GetMPBPtr;
  157.   IF MPBPtr = NIL THEN HALT END;
  158.   WriteString ('F(ree list or U(sed list or B(oth ? ');
  159.   REPEAT
  160.     Read (ch); ch:= CAP (ch)
  161.   UNTIL (ch='B') OR (ch='U') OR (ch='F') OR (ch=33C);
  162.   IF ch=33C THEN RETURN END;
  163.   WriteLn;
  164.   WriteString ('ActProcess: '); WriteLHex (ProcessID^);
  165.   WriteLn;
  166.   GetMPB (mpb);
  167.   IF ch='B' THEN
  168.     used:= mpb.free;
  169.     WriteString ('FREE:');
  170.     WriteLn;
  171.     WHILE (used # NIL) & (ADDRESS (used) >= $800L) DO
  172.       prt (used);
  173.       IF ch=33C THEN RETURN END;
  174.       used:= used^.next;
  175.     END;
  176.     used:= mpb.used;
  177.     WriteString ('USED:');
  178.     WriteLn;
  179.     WHILE (used # NIL) & (ADDRESS (used) >= $800L) DO
  180.       prt (used);
  181.       IF ch=33C THEN RETURN END;
  182.       used:= used^.next;
  183.     END;
  184.     (* beides gleichzeitig geht nicht, weil free falsch herum geordnet ist
  185.     used:= mpb.used;
  186.     free:= mpb.free;
  187.     LOOP
  188.       IF ADDRESS (used) < $800L THEN EXIT END;
  189.       IF (used = NIL) AND (free = NIL) THEN EXIT END;
  190.       IF (free=NIL) OR ( (used#NIL) & (used^.start > free^.start) ) THEN
  191.         WriteString ('  used! ');
  192.         prt (used);
  193.         used:= used^.next;
  194.       ELSE
  195.         WriteString ('  free! ');
  196.         prt (free);
  197.         free:= free^.next;
  198.       END;
  199.       IF ch=33C THEN RETURN END;
  200.     END;
  201.     *)
  202.   ELSE
  203.     IF ch='U' THEN
  204.       used:= mpb.used
  205.     ELSE
  206.       used:= mpb.free
  207.     END;
  208.     WHILE (used # NIL) & (ADDRESS (used) >= $800L) DO
  209.       WriteString ('MD: '); WriteLHex (used);
  210.       WriteLn;
  211.       prt (used);
  212.       IF ch=33C THEN RETURN END;
  213.       used:= used^.next;
  214.     END;
  215.   END;
  216.   WriteString ('Ende.');
  217.   Read (ch);
  218. END CheckMD.
  219. ə
  220. (* $FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$00000292$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99$FFF68A99Ç$00000EE9T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000011C5$00001103$00000EB1$00000EC0$00000E64$00000EEA$00000EDD$00000EE9$FFEE98EF$FFEE98EF$00001103$000010D9$000011D3$0000113C$0000120C$000011D3áÇÇ*)
  221.